unit GLGUILabel;

interface

uses
  Classes,
  Dialogs,
  GLScene,
  VectorGeometry,
  VectorTypes,
  GLRenderContextInfo,
  GLContext,
  GLtexture,
  GLTextureFormat,
  OpenGLTokens,
  OpenGLAdapter,
  GLS_Mesh,
  GLS_DrawTechnique,
  GLS_ShaderParameter,
  GLS_Material,
  GLMaterial,
  SyncObjs,
  GLGUISkinManager,
  GLState,
  GLSGenerics,
  GLColor,
  GLGUITokens,
  GLGUIUtils,
  GLGUITextComponent,
  GLGUIShaders,
  GLSLog;

type
  TGLGUILabel = class(TGLGUITextComponent)
  protected
    FIsReady: Boolean;
    FCarretX: Single;
    FNeedUpdate: Boolean;
    FSampler: TGLTextureSampler;
    procedure SetText(const AText: String); override;
    function GetHeight: Single; override;
    procedure SetHeight(const AHeight: Single); override;
    function GetWidth: Single; override;
    procedure SetLetterSpacing(ALetterSpacing: Single); override;
    procedure BuildMesh; override;
    function AddChar(const AChar: WideChar): TGLGUICharQuad; override;
    procedure SetID(AID: Cardinal); override;
    procedure CreateMaterial;
    procedure LabelOnSM3UniformSetting(Sender: TGLBaseShaderModel;
      var ARci: TRenderContextInfo);
  public
    constructor Create(AOwner: TComponent); override;
    procedure NotifyGUIChange(Sender: TObject = nil); override;
    function CharAtPosition(X, Y: Single): TGLGUICharQuad; override;
    procedure DoRender(var ARci: TRenderContextInfo;
      ARenderSelf, ARenderChildren: Boolean); override;
    destructor Destroy; override;
  end;

implementation

uses
  GLGUILayer;

type
  TGLTextureImageExAccessProvider = class(TGLTextureImageEx)
  end;

const
  GlyphVertices: Array [0 .. 3] of TAffineVector =
  ((-0.5, 0.5, 0),
  (-0.5, -0.5, 0),
  (0.5, 0.5, 0),
  (0.5, -0.5, 0));
  GlyphTexCoord: Array [0 .. 3] of TVector2f = ((0, 1), (0, 0), (1, 1), (1, 0));

constructor TGLGUILabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLetterSpacing := 0;
  FNeedUpdate := True;
  FAlpha := 1.0;
  CreateMaterial;
end;

procedure TGLGUILabel.SetID(AID: Cardinal);
begin
  FID := AID;
  FBatch.Mesh.TagInteger := FID;
end;

procedure TGLGUILabel.CreateMaterial;
const
  cSamplerName = 'LabelSampler';
begin
  with GetInternalMaterialLibrary do
  begin
    FSampler := Components.GetSamplerByName(cSamplerName);
    if not Assigned(FSampler) then
      FSampler := AddSampler(cSamplerName);
  end;
  FSampler.FilteringQuality := tfIsotropic;
  FSampler.MinFilter := miNearest;
  FSampler.MagFilter := maNearest;

  FBatch.Material := GetInternalMaterialLibrary.Materials.GetLibMaterialByName
    ('TGLGUILabel_Material');
  if FBatch.Material = nil then
  begin
    FBatch.Material := GetInternalMaterialLibrary.Materials.Add;
    with TGLLibMaterialEx(FBatch.Material) do
    begin
      Name := 'TGLGUILabel_Material';
      FixedFunction.BlendingMode := bmTransparency;
      FixedFunction.MaterialOptions := [moNoLighting];
      FixedFunction.Texture.Enabled := True;
      FixedFunction.Texture.EnvMode := tmModulate;
      FixedFunction.DepthProperties.DepthTest := False;
      FixedFunction.DepthProperties.DepthWrite := False;
      FixedFunction.Texture.LibTextureName := Texture.Name;
      FixedFunction.Texture.LibSamplerName := FSampler.Name;
      ShaderModel3.LibVertexShaderName := QuadShader.Vertex;
      ShaderModel3.LibFragmentShaderName := QuadShader.Fragment;
      ShaderModel3.Enabled := True;
      ApplicableLevel := mlSM3;
      OnSM3UniformSetting := LabelOnSM3UniformSetting;
    end;
  end;
  FBatch.Changed := True;
end;

procedure TGLGUILabel.LabelOnSM3UniformSetting(Sender: TGLBaseShaderModel;
  var ARci: TRenderContextInfo);
var
  vLabel: TGLGUILabel;
begin
  with TGLGUILayer(FLayer) do
    vLabel := TGLGUILabel(GUIObjects[TMeshAtom(ARci.Mesh).TagInteger]);
  if Sender.IsValid then
  begin
    if Assigned(vLabel.FTexture) then
    begin
//      ARci.GLStates.TextureBinding[0, ttTexture2D] := vLabel.Texture.Handle.Handle;
      Sender.Uniforms['TexUnit0'].TextureName := vLabel.Texture.Name;
      Sender.Uniforms['TexUnit0'].SamplerName := vLabel.FSampler.Name;
    end;
    Sender.Uniforms['uModulateColor'].vec4 := vLabel.FColor.Color;
    Sender.Uniforms['Alpha'].float := vLabel.Alpha;
    Sender.Uniforms['uAdditiveColor'].vec4 := vLabel.FFillColor.Color;
    Sender.Uniforms['TransformationsMatrix'].mat4 := IdentityHMGMatrix;
  end;
end;

procedure TGLGUILabel.DoRender(var ARci: TRenderContextInfo;
  ARenderSelf, ARenderChildren: Boolean);
  procedure PrepareSelf;
  begin
    if (ocStructure in Changes) or (FNeedUpdate) then
    begin
{$IFDEF GLS_SERVICE_CONTEXT}
      if not(osStreamDraw in ObjectStyle) and IsServiceContextAvaible then
      begin
        if not Assigned(FFinishEvent) then
        begin
          FFinishEvent := TFinishTaskEvent.Create;
          AddTaskForServiceContext(BuildMesh, FFinishEvent);
        end
        else if FFinishEvent.WaitFor(0) = wrSignaled then
        begin
          FFinishEvent.ResetEvent;
          AddTaskForServiceContext(BuildMesh, FFinishEvent);
        end;
        exit;
      end
      else
{$ENDIF GLS_SERVICE_CONTEXT}
        BuildMesh;
    end;
    if ARenderSelf then
    begin
      ARci.PipelineTransformation.Push;
      ARci.PipelineTransformation.ModelMatrix := IdentityHMGMatrix;
      ARci.PipelineTransformation.ViewMatrix := IdentityHMGMatrix;
      ARci.PipelineTransformation.ProjectionMatrix := IdentityHMGMatrix;
      FTransformation := ARci.PipelineTransformation.StackTop;
      ARci.PipelineTransformation.Pop;
      ARci.drawList.Add(@FBatch);
    end;
  end;
begin
  PrepareSelf;
  Font.TransferTexture;
  if ARenderChildren then
    RenderChildren(0, Count - 1, ARci);
end;

procedure TGLGUILabel.BuildMesh;
var
  i, j: Integer;
  vCurrentVertex: TAffineVector;
  vTexCoord: TVector2f;
begin
  with FBatch.Mesh do
  begin
    Lock;
    try
      Clear;
      DeclareAttribute(attrPosition, GLSLType3f);
      DeclareAttribute(attrTexCoord0, GLSLType2f);
      BeginAssembly(mpTRIANGLE_STRIP);
      for i := 0 to FGlyphs.Count - 1 do
      begin
        for j := 0 to Length(GlyphVertices) - 1 do
        begin
          vCurrentVertex[0] := GlyphVertices[j][0];
          vCurrentVertex[1] := GlyphVertices[j][1];
          vCurrentVertex[2] := 0;
          vCurrentVertex := VectorTransform(vCurrentVertex,
            FGlyphs.Items[i].Matrix);

          with FGlyphs[i].Info do
          begin
            vTexCoord[0] := Coordinates[2] +
              (GlyphTexCoord[j][0] * Coordinates[0]);
            vTexCoord[1] := Coordinates[3] +
              (GlyphTexCoord[j][1] * Coordinates[1]);
          end;

          Attribute2f(attrTexCoord0, vTexCoord[0], vTexCoord[1]);
          Attribute3f(attrPosition, vCurrentVertex[0], vCurrentVertex[1], 0);
          EmitVertex;
        end;
       // RestartStrip;
      end;
      EndAssembly;
    finally
      UnLock;
    end;
  end;
  FBatch.Changed := True;
  FNeedUpdate := False;
  ClearStructureChanged;
end;

function TGLGUILabel.AddChar(const AChar: WideChar): TGLGUICharQuad;
var
  vChar: TGLGUICharQuad;
begin
  vChar := TGLGUICharQuad.Create(Self);
  vChar.Info := FFont.GetGlyphInfo(AChar);
  vChar.Texture := FTexture;
  vChar.Y := 0;
  Result := vChar;
end;

procedure TGLGUILabel.SetText(const AText: String);
var
  i: Integer;
  vChar: TGLGUICharQuad;
begin
  inherited;
  FCarretX := 0;

  for i := 0 to FGlyphs.Count - 1 do
    FGlyphs.Items[i].Free;

  FGlyphs.Clear;

  for i := 1 to Length(FText) do
  begin
    vChar := AddChar(AText[i]);
    FCarretX := FCarretX + vChar.Info.Width / 2 + FLetterSpacing;
    vChar.X := FCarretX;
    FCarretX := FCarretX + vChar.Info.CharWidth - vChar.Info.Width / 2;
    FGlyphs.Add(vChar);
  end;

  Width := TextWidth;
  Height := TextHeight;

  for i := 0 to FGlyphs.Count - 1 do
  begin
    vChar := FGlyphs[i];
    vChar.X := vChar.X - FWidth / 2;
  end;

  FNeedUpdate := True;

  DispatchEvent('TextUpdated');
end;

function TGLGUILabel.GetHeight: Single;
begin
  Result := GetTextHeight;
end;

procedure TGLGUILabel.SetHeight(const AHeight: Single);
begin
end;

function TGLGUILabel.GetWidth: Single;
begin
  Result := GetTextWidth;
end;

procedure TGLGUILabel.SetLetterSpacing(ALetterSpacing: Single);
begin
  FLetterSpacing := ALetterSpacing;
  Text := FText;
end;

function TGLGUILabel.CharAtPosition(X, Y: Single): TGLGUICharQuad;

  function PointInQuad(const X, Y: Single; const AMatrix: TMatrix): Boolean;
  var
    vMouse: TVector;
  begin
    vMouse := VectorTransform(VectorMake(X, -Y, 1, 1), MatrixInvert(AMatrix));
    Result := ((vMouse[0] > -0.5) and (vMouse[0] < 0.5) and (vMouse[1] > -0.5)
      and (vMouse[1] < 0.5));
  end;

var
  i: Integer;
begin
  Result := nil;
  for i := 0 to FGlyphs.Count - 1 do
    if PointInQuad(X, Y, FGlyphs[i].Matrix) then
    begin
      Result := FGlyphs[i];
      Break;
    end;
end;

procedure TGLGUILabel.NotifyGUIChange(Sender: TObject);
var
  i: Integer;
begin
  inherited;
  FNeedUpdate := True;
end;

destructor TGLGUILabel.Destroy;
begin
  Text := '';
  inherited;
end;

end.
